COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "RODGRA"
C00017 00003	INTEGER FJ
C00021 ENDMK
C⊗;
BEGIN "RODGRA"
REAL X,Y,TH,AL,VEL,TDEL,DX,DY,SDT,CDT,XO,YO,THO;  STRING A;  INTEGER B,CH;
REQUIRE "TYPHDR.SAI[GOD,HPM]" SOURCE_FILE;

REAL TERM_VV,TERM_V,ACCEL_T,DECAY_TT,DECAY_T,CART_SIZE,TURN_V,DRAG_H,ALMAX,ALMIN,IRMAX;
DEFINE PI="3.14159265"; DEFINE TWOPI="(2.*PI)"; DEFINE TICK="(1/60)";
REAL ARRAY TIMES[0:32]; INTEGER ARRAY ACTS[0:32],MESG[1:33]; INTEGER PNEXT;

REAL PROCEDURE SIGN(REAL X,S);  RETURN(IF S<0 THEN -ABS(X) ELSE ABS(X));
REAL PROCEDURE EXPP(REAL X);    RETURN(EXP((X MAX -60) MIN 60));

PROCEDURE PATH(REAL X,Y,TH; REFERENCE REAL IR,D1,D2);
   BEGIN "PATH"   REAL ZIGN;
   WHILE TH<-PI DO TH←TH+TWOPI; WHILE TH>PI DO TH←TH-TWOPI;
   IF ABS(Y)<0.01 ∧ ABS(TH)<0.001 THEN BEGIN IR←0; D1←D2←X/2; END
   ELSE
      BEGIN REAL CT,ST,CTP1; CT←COS(TH);  ST←SIN(TH);  CTP1←CT+1;
      IF ABS(TH)<0.001 THEN
	 BEGIN REAL Q,Q2; Q←X/Y; Q2←Q*Q;
	 IR←4-TH*(2*Q-TH*(Q2/4-3/4)); IR←Y*IR/(Y*Y+X*X);  END
      ELSE
	 BEGIN REAL OMCT,STSQ;   OMCT←1-CT;  STSQ←ST*ST;
	 IR←(STSQ+2*OMCT)*X*X-2*CTP1*ST*Y*X+(4-STSQ)*Y*Y;
	 IR←2.0*OMCT/(X*ST-Y*CTP1+SQRT(IR));  END;
      ZIGN←SIGN(1,IR); D1←ATAN2(IR*X+ST,CTP1-IR*Y)*ZIGN; D2←D1-TH*ZIGN;
      WHILE D1<-PI DO D1←D1+TWOPI;     WHILE D2<-PI DO D2←D2+TWOPI;
      WHILE D1>PI DO D1←D1-TWOPI;     WHILE D2>PI DO D2←D2-TWOPI;
      D1←D1/ABS(IR); D2←D2/ABS(IR);
      END;
   END "PATH";

BOOLEAN PROCEDURE SCOUT(REAL X,Y,TH; REFERENCE REAL IR,D1,D2);
   BEGIN  REAL XIR,XD1,XD2,S1,S2;  BOOLEAN OK;
   REAL PROCEDURE COST(REAL IR,D1,D2);
      RETURN(IF ABS(IR)>IRMAX ∨ ABS(D1)+ABS(D2)>3*(ABS(X)+ABS(Y)) 
	     THEN 10000*(1+ABS(IR)) ELSE (ABS(D1)+ABS(D2)));
   OK←FALSE; D1←D2←IR←1000.;
   FOR S1←1,-1 DO FOR S2←1,-1 DO
      BEGIN
      PATH(S1*X,S2*Y,S1*S2*TH,XIR,XD1,XD2);
      XIR←S2*XIR;
      XD1←S1*XD1;
      XD2←S1*XD2;
      IF COST(XIR,XD1,XD2)<COST(IR,D1,D2) THEN
	 BEGIN D1←XD1; D2←XD2; IR←XIR; OK←TRUE; END;
      END;
   RETURN(OK);
   END;

PROCEDURE PLACE(INTEGER ACT; REAL T1,TEXTN);
   BEGIN REAL T2; INTEGER I,J,LO,HI;

   IF TEXTN<.021 THEN RETURN; T2←T1+TEXTN;

   I←0; WHILE I<PNEXT ∧ T1>TIMES[I]-.009 DO I←I+1;

   IF I>0 ∧ ABS(T1-TIMES[I-1])<.01 THEN LO←I ELSE
      BEGIN
      FOR J←PNEXT-1 STEP -1 UNTIL I DO
         BEGIN
         TIMES[J+1]←TIMES[J]; ACTS[J+1]←ACTS[J];
         END;
      TIMES[I]←T1;
      IF I=0 THEN ACTS[I+1]←0;
      LO←I+1;
      PNEXT←PNEXT+1;
      END;

   I←PNEXT; WHILE I>1 ∧ T2<TIMES[I-1]+.009 DO I←I-1;

   IF I<PNEXT ∧ ABS(T2-TIMES[I])<.01 THEN HI←I ELSE
      BEGIN
      FOR J←PNEXT-1 STEP -1 UNTIL I DO
         BEGIN
         TIMES[J+1]←TIMES[J]; ACTS[J+1]←ACTS[J];
         END;
      TIMES[I]←T2;
      IF I=PNEXT THEN ACTS[I]←0;
      HI←I;
      PNEXT←PNEXT+1;
      END;

   FOR J←LO STEP 1 UNTIL HI DO ACTS[J]←ACTS[J] LOR ACT;

   END;

PROCEDURE CLEAR;  BEGIN PNEXT←0; RETURN; END;

PROCEDURE TURN(REAL T0,TEXTN); PLACE(IF TEXTN>0. THEN '10 ELSE '4,T0,ABS(TEXTN));

PROCEDURE RUN(REAL T0,TEXTN);  PLACE(IF TEXTN>0 THEN '2 ELSE '3,T0,ABS(TEXTN));

PROCEDURE CENT(REAL T0,TEXTN); PLACE('14,T0,ABS(TEXTN));

PROCEDURE SLIDE(REAL T0,TEXTN(3));
   BEGIN comment operate the camera slider;
   REAL DT; DT←ABS(TEXTN)/3;
   PLACE('00,T0,DT);  PLACE('60,T0+DT,DT);
   PLACE(IF TEXTN>0 THEN '40 ELSE '20,T0+2*DT,DT);
   END;

PROCEDURE SLEEP(REAL T0,TEXTN);   PLACE(0,T0,ABS(TEXTN));

PROCEDURE HONK(REAL T0,TEXTN);    PLACE('1,T0,ABS(TEXTN));

PROCEDURE FILM(REAL T0,TEXTN);    PLACE('100,T0,ABS(TEXTN));

PROCEDURE SEAL;
   BEGIN INTEGER I;
   FOR I← 1 STEP 1 UNTIL PNEXT-1 DO
      BEGIN
      MESG[I]←(TIMES[I]-TIMES[I-1])/TICK+0.5;
      MESG[I]←(MESG[I] LSH 18) LOR ACTS[I];
      END;
   MESG[PNEXT]←0;
   END;

PROCEDURE MAIL;
   BEGIN
   INTEGER FOO,B,C;
   OPEN('13,"CAR",'10,0,1,FOO,FOO,FOO);   START_CODE OUTPUT '13,0; END;
   FOR B←1 STEP 1 UNTIL PNEXT-1 DO
      BEGIN
      C←((MESG[B] LSH 9) LAND '177000) LOR (MESG[B] LAND '777777000000);
      WORDOUT('13,C);
      END;
   WORDOUT('13,0); QUICK_CODE OUTPUT '13,0; END; RELEASE('13);
   END;

PROCEDURE SLIDER(INTEGER N);
   BEGIN  comment  slide the camera N increments left (neg N for right);
   INTEGER I,D;
   CLEAR;
   D←IF N<0 THEN -1 ELSE 1;
   FOR I←1 STEP 1 UNTIL ABS(N) DO SLIDE((I-1)*3,3*D);
   SLEEP(ABS(N)*3,1);
   SEAL; MAIL;
   END;

PROCEDURE ROLLEM(REAL T);
   BEGIN comment operate movie camera for T seconds;
   CLEAR; FILM(0,T); SEAL; MAIL;
   END;

PROCEDURE STARTS;
   BEGIN
   PNEXT←0;
   TERM_V←2; ACCEL_T←0.5; DECAY_T←15/20;
   CART_SIZE←34/12;          comment wheel center to wheel center;
   TURN_V←(64.5*PI/180)/2.4;  comment hard left to hard right takes 2.4 secs;
   DRAG_H←1/2.5;   comment speed is halved when turning rad = 2.5 ft;
   IRMAX←1/5.3;
   ALMAX←ATAN(CART_SIZE/(1/IRMAX+CART_SIZE/2));
   ALMIN←ATAN(CART_SIZE/(-1/IRMAX+CART_SIZE/2));
   END;

REQUIRE STARTS INITIALIZATION;

REAL PROCEDURE TRNTIM(REAL IR);
   RETURN(ATAN(IR/(1/CART_SIZE+IR/2))/TURN_V);

REAL PROCEDURE ONDIST(REAL T);
   RETURN(SIGN(TERM_VV*(ABS(T)-ACCEL_T*(1-EXPP(-ABS(T)/ACCEL_T))),T));

REAL PROCEDURE VELOC(REAL T);
   RETURN(SIGN(TERM_VV*(1-EXPP(-ABS(T)/ACCEL_T)),T));

REAL PROCEDURE COAST(REAL T); RETURN(VELOC(T)*DECAY_T);

REAL PROCEDURE ONTIM(REAL D);
   BEGIN REAL L,H,M,P;
   IF D>0 THEN BEGIN L←-.001; H←1; WHILE ONDIST(H)+COAST(H)<D+1 DO H←2*H; END
	  ELSE BEGIN H←.001; L←-1; WHILE ONDIST(L)+COAST(L)>D-1 DO L←2*L; END;
   WHILE ABS((P←ONDIST(M←(L+H)/2)+COAST(M))-D)>.001 
	 ∧ L<H-.001 DO IF P>D THEN H←M ELSE L←M;
   RETURN(M);
   END;

REAL PROCEDURE ATTIME(REAL T,D);
   BEGIN
   REAL D1; D1←ABS(D)-ABS(ONDIST(T));
   IF D1<0. THEN
      BEGIN REAL L,H,M,P;
      IF T>0 THEN  BEGIN L←-.001; H←T+1; END ELSE  BEGIN L←T-1; H←.001; END;
      WHILE ABS((P←ONDIST(M←(L+H)/2))-D)>0.001 ∧ L<H-.001 DO
	   IF P>D THEN H←M ELSE L←M;
      RETURN(M); END
   ELSE
   RETURN(T+SIGN(LOG((1-D1/(DECAY_T*VELOC(T))) MAX 1.0@-10)*DECAY_T,D1));
   END;


PROCEDURE SIMUL(REAL DT; REFERENCE REAL X,Y,TH,AL,VEL);
   BEGIN INTEGER B,I,J,K; REAL MOT,TRN,IR,VMAX,TDEC;
   FOR B←1 STEP 1 UNTIL PNEXT-1 DO
      BEGIN
      I←(MESG[B] LSH -18)*TICK/DT+0.5;  DT←(MESG[B] LSH -18)*TICK/I;
      MOT←CASE (MESG[B] LAND '3) OF (0, 0, 1, -1);
      K←MESG[B] LAND '14;
      TRN←(IF K='14 THEN 2 ELSE IF K='10 THEN 1 ELSE IF K='4 THEN -1 ELSE 0);
      FOR J←1 STEP 1 UNTIL I DO
	 BEGIN  REAL SAL,CAL;
	 AL←((AL+(IF TRN=2 THEN (IF AL>0 THEN -DT*TURN_V ELSE DT*TURN_V)
			   ELSE DT*TRN*TURN_V)) MAX ALMIN) MIN ALMAX;
	 SAL←SIN(AL); CAL←COS(AL); IR←SAL/(CART_SIZE*(CAL-SAL/2));
         VMAX←TERM_V*DRAG_H/(ABS(IR)+DRAG_H);
         TDEC←DECAY_T*DRAG_H/(ABS(IR)+DRAG_H);
	 VEL←VEL+(IF MOT=0 THEN -(DT/TDEC MIN 1)*VEL
                           ELSE (SIGN(VMAX,MOT)-VEL)*DT/ACCEL_T);
         TH←TH+VEL*DT*IR;
         LINE(X,Y,X←X+COS(TH)*VEL*DT,Y←Y+SIN(TH)*VEL*DT,3);
	 END;
      END;
   END;

BOOLEAN PROCEDURE THRASH(REAL X,Y,TH; REFERENCE REAL IR,D1,D2);
   BEGIN REAL Y1,X1,TH1,Y2,X2,TH2,AL,VEL,XB,YB,THB; INTEGER I;



   BOOLEAN PROCEDURE CHART(REAL X,Y,TH; REFERENCE REAL IR,D1,D2);
      BEGIN  REAL TT1,TD12,TD1,TT2;
      IF ¬SCOUT(X,Y,TH,IR,D1,D2) THEN RETURN(FALSE);

      TERM_VV←TERM_V*DRAG_H/(ABS(IR)+DRAG_H);
      DECAY_TT←DECAY_T*DRAG_H/(ABS(IR)+DRAG_H);

      TT1←TRNTIM(IR);  TD12←ONTIM(D1+D2);
      TD1←ATTIME(TD12,D1);
      TT2←TRNTIM(-IR);  TT1←SIGN(ABS(TD1) MIN ABS(TT1),TT1);

      CLEAR; RUN(0,TD12); FILM(-1,ABS(TD12)+3); SLEEP(ABS(TD12),4);
      CENT(-3,3); CENT(ABS(TD12)+1-ABS(TT2),ABS(TT2)+3);
      IF ABS(D1)>0.2 THEN
	 BEGIN TURN(0,TT1);
	 IF ABS(D2)>0.2 THEN
	    BEGIN CENT(ABS(TD1)-1.1*ABS(TT1),1.1*ABS(TT1)); TURN(ABS(TD1),TT2); END;
	 END
      ELSE
	 IF ABS(D2)>0.2 THEN TURN(0,TT2);

      SEAL; RETURN(TRUE);
      END;

   Y1←Y;  X1←X;  TH1←TH;
   FOR I←0 STEP 1 UNTIL 15 DO
      BEGIN "TRIAL"
      IF ¬CHART(X1,Y1,TH1,IR,D1,D2) THEN DONE "TRIAL";
      Y2←X2←TH2←AL←VEL←0.;  SIMUL(1/30,X2,Y2,TH2,AL,VEL);
      IF (ABS(Y-Y2)<.1∧ABS(X-X2)<.1∧ABS(TH-TH2)<.1) THEN RETURN(TRUE);
      Y1←Y1+(Y-Y2)*.8; X1←X1+(X-X2)*.8; TH1←TH1+(TH-TH2)*.8;
      END "TRIAL";

      BEGIN
      REAL D,T;
      TERM_VV←TERM_V;
      DECAY_TT←DECAY_T;
      CLEAR;
      D←SQRT(X↑2+Y↑2); T←ONTIM(SIGN(D,X)); RUN(0,T); FILM(-1,ABS(T)+3);
      TURN(0,SIGN((ABS(T)+1)/2,Y)); 
      CENT((ABS(T)+1)/2,(ABS(T)+1)/2+3);
      SEAL;
      END;

   Y2←X2←TH2←AL←VEL←0.;  SIMUL(1/30,X2,Y2,TH2,AL,VEL);
   RETURN(ABS(Y-Y2)<.5∧ABS(X-X2)<.5∧ABS(TH-TH2)<.2);
   END;

PROCEDURE BACK_UP(REAL D);
   BEGIN
   REAL T;
   DECAY_TT←DECAY_T;
   TERM_VV←TERM_V;
   CLEAR;
   print(d," feet, ");
   T←ONTIM(-D); PRINT(T," secs ",'15&'12);
   RUN(0,T); FILM(-1,ABS(T)+3);
   CENT(0,ABS(T)+3);
   SEAL;
   END;

PROCEDURE BACK(REAL IR,D1,D2; REFERENCE REAL X,Y,TH);
   BEGIN  TH←IR*(D2-D1);
   IF IR=0 THEN BEGIN Y←0; X←D1+D2; END ELSE
   BEGIN Y←(-1-COS(TH)+2*COS(D1*IR))/IR; X←(2*SIN(D1*IR)+SIN(TH))/IR; END;
   END;
INTEGER FJ;

PROCEDURE ARROW(REAL X1,Y1,X2,Y2);
   BEGIN
   REAL DX,DY,D; REAL ARRAY HEADX,HEADY[1:3];
   LINE(X1,Y1,X2,Y2,5); DX←X2-X1; DY←Y2-Y1; D←SQRT(DX↑2+DY↑2);
   DX←0.25*DX/D; DY←0.25*DY/D;
   HEADX[1]←X2; HEADY[1]←Y2;
   HEADX[2]←X2-DX-DY/4;  HEADY[2]←Y2-DY+DX/4;
   HEADX[3]←X2-DX+DY/4;  HEADY[3]←Y2-DY-DX/4;
   POLYGO(3,HEADX[1],HEADY[1]);
   END;

FJ←FILJOB("SIMU.GOD[DIA,HPM]");

FNTSELECT(2,"METMBM");
CH←-1;

WHILE TRUE DO
   BEGIN REAL IR,D1,D2,I,J; DEFINE METER="3.281";
   PRINT("X, Y, TH:");
   A←INCHWL;
   IF (A LAND '137)="S" THEN SLIDER(CVD(A[2 TO ∞])) ELSE
   IF (A LAND '137)="C" THEN
      BEGIN
      A←A[2 TO ∞];
      XO←X;
      YO←Y;
      THO←TH;
      X←REALSCAN(A,B);
      Y←REALSCAN(A,B);
      TH←REALSCAN(A,B)*PI/180.;
      END
   ELSE
      BEGIN
      X←REALSCAN(A,B);
      Y←REALSCAN(A,B);
      TH←REALSCAN(A,B)*PI/180.;
      XO←0; YO←0; THO←0;
      DDINIT; LITEN;
      DX←1.05*((ABS(X)+1) MAX (4*(ABS(Y)+1)/3));
      DY←0.6*((ABS(Y)+1) MAX (3*(ABS(X)+1)/4));
      SCREEN(-DX*1.01/5,-DY*1.01,DX*1.01,DY*1.01); LITEN;
      FOR I←0 STEP METER UNTIL DX DO LINE(I,-DY,I,DY);
      FOR J←0 STEP METER UNTIL DY DO LINE(-DX,J,DX,J);
      FOR I←0 STEP -METER UNTIL -DX DO LINE(I,-DY,I,DY);
      FOR J←0 STEP -METER UNTIL -DY DO LINE(-DX,J,DX,J);
      ARROW(-.5,0,0,0);
      FNTPOS(-.5,0);
      DEPOSIT(0,0,BOTTOMIFY(RIGHTIFY(JTXT(2,"Start"))));
      ARROW(X,Y,X+.5*COS(TH),Y+.5*SIN(TH));
      FNTPOS(X+.5*COS(TH),Y+.5*SIN(TH),COS(TH),COS(TH),-SIN(TH),SIN(TH));
      DEPOSIT(0,0,LEFTIFY(YCENTER(JTXT(2,"Finish"))));
	 BEGIN
         REAL IR,D1,D2,T,XO,YO;
	 SCOUT(X,Y,TH, IR,D1,D2);
         XO←1/IR; YO←1/IR;
	 FOR T←0 STEP PI/30 UNTIL 2*PI DO
            LINE(XO,YO,XO←COS(T)/IR,YO←(1+SIN(T))/IR);
         XO←X+(1+SIN(TH))/IR; YO←Y-COS(TH)/IR;
	 FOR T←0 STEP PI/30 UNTIL 2*PI DO
            LINE(XO,YO,XO←X+(SIN(TH)+COS(T))/IR,YO←Y+(SIN(T)-COS(TH))/IR);
	 END;
      END;

   SDT←SIN(THO); CDT←COS(THO);
   DX←X-XO;  DY←Y-YO;  TH←TH-THO; X←DX*CDT+DY*SDT;   Y←DY*CDT-DX*SDT;

   IF ¬THRASH(X,Y,TH,IR,D1,D2) THEN PRINT("LOSE",'15&'12);
      TDEL←0.01; X←XO; Y←YO; TH←THO; AL←VEL←0;
      LITEN; SIMUL(TDEL,X,Y,TH,AL,VEL);
      INVEN; ELLIPS(X-.1,Y-.1,X+.1,Y+.1); LITEN;
      DPYUP(CH);
      KILJOB(FJ);
   FJ←DDJOB; GRAFIL("SIMU.GOD[DIA,HPM]"); INCHWL; KILJOB(FJ);
   END;

END "RODGRA";